Attribute VB_Name = "modMain"
Option Explicit
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpString As String, ByVal lpfilename As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nsize As Long, ByVal lpfilename As String) As Long

' General constants
Public GAME_NAME As String
Public WEBSITE As String
Public MAX_PLAYERS As Long
Public MAX_SPELLS As Long
Public MAX_MAPS As Long
Public MAX_SHOPS As Long
Public MAX_ITEMS As Long
Public MAX_NPCS As Long
Public MAX_MAP_ITEMS As Long
Public MAX_EMOTICONS As Long
Public MAX_SPELL_ANIM As Long
Public MAX_BLT_LINE As Long

Public Const MAX_ARROWS = 100
Public Const MAX_PLAYER_ARROWS = 100

Public Const MAX_INV = 24
Public Const MAX_BANK = 50
Public Const MAX_MAP_NPCS = 15
Public Const MAX_PLAYER_SPELLS = 20
Public Const MAX_TRADES = 6
Public Const MAX_PLAYER_TRADES = 8
Public Const MAX_NPC_DROPS = 10

Public Const NO = 0
Public Const YES = 1

' Account constants
Public Const NAME_LENGTH = 20
Public Const MAX_CHARS = 5

Public MAX_MAPX As Variant
Public MAX_MAPY As Variant

'Public Max_Classes As Long
Public Max_Classes As Byte

Public Const TILE_TYPE_WALKABLE = 0
Public Const TILE_TYPE_BLOCKED = 1
Public Const TILE_TYPE_WARP = 2
Public Const TILE_TYPE_ITEM = 3
Public Const TILE_TYPE_NPCAVOID = 4
Public Const TILE_TYPE_KEY = 5
Public Const TILE_TYPE_KEYOPEN = 6
Public Const TILE_TYPE_HEAL = 7
Public Const TILE_TYPE_KILL = 8
Public Const TILE_TYPE_SHOP = 9
Public Const TILE_TYPE_CBLOCK = 10
Public Const TILE_TYPE_ARENA = 11
Public Const TILE_TYPE_SOUND = 12
Public Const TILE_TYPE_SPRITE_CHANGE = 13
Public Const TILE_TYPE_SIGN = 14
Public Const TILE_TYPE_DOOR = 15
Public Const TILE_TYPE_NOTICE = 16
Public Const TILE_TYPE_CHEST = 17
Public Const TILE_TYPE_CLASS_CHANGE = 18
Public Const TILE_TYPE_SCRIPTED = 19
Public Const TILE_TYPE_NPC_SPAWN = 20
Public Const TILE_TYPE_BANK = 21

' Item constants
Public Const ITEM_TYPE_NONE = 0
Public Const ITEM_TYPE_WEAPON = 1
Public Const ITEM_TYPE_ARMOR = 2
Public Const ITEM_TYPE_HELMET = 3
Public Const ITEM_TYPE_SHIELD = 4
Public Const ITEM_TYPE_POTIONADDHP = 5
Public Const ITEM_TYPE_POTIONADDMP = 6
Public Const ITEM_TYPE_POTIONADDSP = 7
Public Const ITEM_TYPE_POTIONSUBHP = 8
Public Const ITEM_TYPE_POTIONSUBMP = 9
Public Const ITEM_TYPE_POTIONSUBSP = 10
Public Const ITEM_TYPE_KEY = 11
Public Const ITEM_TYPE_CURRENCY = 12
Public Const ITEM_TYPE_SPELL = 13

Type TileRec
    Ground As Long
    Mask As Long
    Anim As Long
    Mask2 As Long
    M2Anim As Long
    Fringe As Long
    FAnim As Long
    Fringe2 As Long
    F2Anim As Long
    Type As Byte
    Data1 As Long
    Data2 As Long
    Data3 As Long
    String1 As String
    String2 As String
    String3 As String
    Light As Long
    GroundSet As Byte
    MaskSet As Byte
    AnimSet As Byte
    Mask2Set As Byte
    M2AnimSet As Byte
    FringeSet As Byte
    FAnimSet As Byte
    Fringe2Set As Byte
    F2AnimSet As Byte
End Type

Type MapRec
    Name As String * 40
    Revision As Long
    Moral As Byte
    Up As Long
    Down As Long
    Left As Long
    Right As Long
    Music As String
    BootMap As Long
    BootX As Byte
    BootY As Byte
    Shop As Long
    Indoors As Byte
    Tile() As TileRec
    Npc(1 To MAX_MAP_NPCS) As Long
End Type

Type ClassRec
    Name As String * NAME_LENGTH
    MaleSprite As Long
    FemaleSprite As Long
    
    Locked As Long
    
    STR As Long
    DEF As Long
    Speed As Long
    MAGI As Long
    
    ' For client use
    HP As Long
    MP As Long
    SP As Long
End Type

Type ItemRec
    Name As String * NAME_LENGTH
    desc As String * 150
    
    Pic As Long
    Type As Byte
    Data1 As Long
    Data2 As Long
    Data3 As Long
    StrReq As Long
    DefReq As Long
    SpeedReq As Long
    ClassReq As Long
    AccessReq As Byte
    
    AddHP As Long
    AddMP As Long
    AddSP As Long
    AddStr As Long
    AddDef As Long
    AddMagi As Long
    AddSpeed As Long
    AddEXP As Long
    AttackSpeed As Long
End Type

Type SpellAnimRec
    CastedSpell As Byte
    
    SpellTime As Long
    SpellVar As Long
    SpellDone As Long
    
    Target As Long
    TargetType As Long
End Type

Type PlayerArrowRec
    Arrow As Byte
    ArrowNum As Long
    ArrowAnim As Long
    ArrowTime As Long
    ArrowVarX As Long
    ArrowVarY As Long
    ArrowX As Long
    ArrowY As Long
    ArrowPosition As Byte
    ArrowAmount As Long
End Type

Type MapItemRec
    Num As Long
    Value As Long
    Dur As Long
    
    x As Byte
    y As Byte
End Type

Type NPCEditorRec
    ItemNum As Long
    ItemValue As Long
    Chance As Long
End Type

Type NpcRec
    Name As String * NAME_LENGTH
    AttackSay As String * 100
    
    Sprite As Long
    SpawnSecs As Long
    Behavior As Byte
    Range As Byte
        
    STR  As Long
    DEF As Long
    Speed As Long
    MAGI As Long
    Big As Long
    MaxHp As Long
    EXP As Long
    SpawnTime As Long
    
    ItemNPC(1 To MAX_NPC_DROPS) As NPCEditorRec
End Type

Type BankRec
    Num As Long
    Value As Long
    Dur As Long
End Type

Type PlayerInvRec
    Num As Long
    Value As Long
    Dur As Long
End Type

Type MapNpcRec
    Num As Long
    
    Target As Long
    
    HP As Long
    MaxHp As Long
    MP As Long
    SP As Long
    
    Map As Long
    x As Byte
    y As Byte
    Dir As Byte
    Big As Byte

    ' Client use only
    XOffset As Integer
    YOffset As Integer
    Moving As Byte
    Attacking As Byte
    AttackTimer As Long
End Type

Type TradeItemRec
    GiveItem As Long
    GiveValue As Long
    GetItem As Long
    GetValue As Long
End Type

Type TradeItemsRec
    Value(1 To MAX_TRADES) As TradeItemRec
End Type

Type ShopRec
    Name As String * NAME_LENGTH
    JoinSay As String * 100
    LeaveSay As String * 100
    FixesItems As Byte
    TradeItem(1 To 6) As TradeItemsRec
End Type

Type SpellRec
    Name As String * NAME_LENGTH
    ClassReq As Long
    LevelReq As Long
    Sound As Long
    MPCost As Long
    Type As Long
    Data1 As Long
    Data2 As Long
    Data3 As Long
    Range As Byte
    
    SpellAnim As Long
    SpellTime As Long
    SpellDone As Long
    
    AE As Long
End Type

Type TempTileRec
    DoorOpen As Byte
End Type

Type PlayerTradeRec
    InvNum As Long
    InvName As String
End Type

Type EmoRec
    Pic As Long
    Command As String
End Type

Type DropRainRec
    x As Long
    y As Long
    Randomized As Boolean
    Speed As Byte
End Type

Type PlayerRec
    ' General
    Name As String * NAME_LENGTH
    Guild As String
    Guildaccess As Byte
    Class As Long
    Sprite As Long
    Level As Long
    EXP As Long
    Access As Byte
    PK As Byte
    
    ' Vitals
    HP As Long
    MP As Long
    SP As Long
    
    ' Stats
    STR As Long
    DEF As Long
    Speed As Long
    MAGI As Long
    POINTS As Long
    
    ' Worn equipment
    ArmorSlot As Long
    WeaponSlot As Long
    HelmetSlot As Long
    ShieldSlot As Long
    
    ' Inventory
    Inv(1 To MAX_INV) As PlayerInvRec
    Spell(1 To MAX_PLAYER_SPELLS) As Long
    Bank(1 To MAX_BANK) As BankRec
       
    ' Position
    Map As Long
    x As Byte
    y As Byte
    Dir As Byte
    
    ' Client use only
    MaxHp As Long
    MaxMP As Long
    MaxSP As Long
    XOffset As Integer
    YOffset As Integer
    Moving As Byte
    Attacking As Byte
    AttackTimer As Long
    MapGetTimer As Long
    CastedSpell As Byte
    
    SpellNum As Long
    SpellAnim() As SpellAnimRec

    EmoticonNum As Long
    EmoticonTime As Long
    EmoticonVar As Long
    
    LevelUp As Long
    LevelUpT As Long

    Arrow(1 To MAX_PLAYER_ARROWS) As PlayerArrowRec
End Type

' Maximum classes
Public Map() As MapRec
Public TempTile() As TempTileRec
Public Player() As PlayerRec
Public Class() As ClassRec
Public Item() As ItemRec
Public Npc() As NpcRec
Public MapItem() As MapItemRec
Public MapNpc(1 To MAX_MAP_NPCS) As MapNpcRec
Public Shop() As ShopRec
Public Spell() As SpellRec
Public Emoticons() As EmoRec
Public MapReport() As MapRec

Public MAX_RAINDROPS As Long
Public BLT_RAIN_DROPS As Long
Public DropRain() As DropRainRec

Public BLT_SNOW_DROPS As Long
Public DropSnow() As DropRainRec

Type ItemTradeRec
    ItemGetNum As Long
    ItemGiveNum As Long
    ItemGetVal As Long
    ItemGiveVal As Long
End Type
Type TradeRec
    Items(1 To MAX_TRADES) As ItemTradeRec
    Selected As Long
    SelectedItem As Long
End Type
Public Trade(1 To 6) As TradeRec

Type ArrowRec
    Name As String
    Pic As Long
    Range As Byte
    Amount As Long
End Type
Public Arrows(1 To MAX_ARROWS) As ArrowRec

Type BattleMsgRec
    Msg As String
    index As Byte
    Color As Byte
    Time As Long
    Done As Byte
    y As Long
End Type
Public BattlePMsg() As BattleMsgRec
Public BattleMMsg() As BattleMsgRec

Type ItemDurRec
    Item As Long
    Dur As Long
    Done As Byte
End Type
Public ItemDur(1 To 4) As ItemDurRec

Public Inventory As Long


Public Const MAX_ATTRIBUTE_NPCS = 25
Public MapAttributeNpc() As MapNpcRec
Public SaveMapAttributeNpc() As MapNpcRec

'Public Npc() As NpcRec
'Public Item() As ItemRec
'Public Shop() As ShopRec
'Public Spell() As SpellRec
'Public Class() As ClassRec
'Public Map() As MapRec
Public ShopMap() As Boolean
Public MapNPCs() As Long

Sub Main()
Dim FileName As String, i As Long

    SetStatus "Loading Program..."
    frmMain.Visible = True
    
    frmMain.Enabled = False
    
    If LCase(Dir(App.Path & "\html docs", vbDirectory)) <> "html docs" Then
        Call MkDir(App.Path & "\HTML Docs")
    End If
    
    MAX_MAPX = 30
    MAX_MAPY = 30
    
    FileName = App.Path & "\DBConfig.ini"
    If FileExist(FileName) = False Then
        PutVar FileName, "CONFIG", "PageTitle", "NPC Database"
        PutVar FileName, "CONFIG", "Font", "Verdana"
        PutVar FileName, "CONFIG", "FontSize", "10"
        PutVar FileName, "CONFIG", "FontColor", "#C0C0C0"
        PutVar FileName, "CONFIG", "Background", "#003663"
        PutVar FileName, "CONFIG", "TableMBColor", "#022B4C"
        PutVar FileName, "CONFIG", "TableDBColor", "#003663"
        PutVar FileName, "CONFIG", "TableBorderColor", "#376F9C"
        PutVar FileName, "CONFIG", "TableWidth", "500"
        
        PutVar FileName, "MAXES", "MAX_ITEMS", "255"
        PutVar FileName, "MAXES", "MAX_NPCS", "255"
        PutVar FileName, "MAXES", "MAX_SHOPS", "255"
        PutVar FileName, "MAXES", "MAX_SPELLS", "255"
        PutVar FileName, "MAXES", "MAX_MAPS", "255"
    End If
    
    MAX_ITEMS = GetVar(FileName, "MAXES", "MAX_ITEMS")
    MAX_NPCS = GetVar(FileName, "MAXES", "MAX_NPCS")
    MAX_SHOPS = GetVar(FileName, "MAXES", "MAX_SHOPS")
    MAX_SPELLS = GetVar(FileName, "MAXES", "MAX_SPELLS")
    MAX_MAPS = GetVar(FileName, "MAXES", "MAX_MAPS")
        
    ReDim Map(1 To MAX_MAPS) As MapRec
    ReDim ShopMap(1 To MAX_MAPS) As Boolean
    ReDim Npc(1 To MAX_NPCS) As NpcRec
    ReDim Item(1 To MAX_ITEMS) As ItemRec
    ReDim Shop(1 To MAX_SHOPS) As ShopRec
    ReDim Spell(1 To MAX_SPELLS) As SpellRec
    ReDim MapNPCs(1 To MAX_NPCS) As Long
    
    For i = 1 To MAX_MAPS
        ShopMap(i) = False
        ReDim Map(i).Tile(0 To MAX_MAPX, 0 To MAX_MAPY) As TileRec
    Next i
    
    For i = 1 To MAX_NPCS
        MapNPCs(i) = 0
    Next i
    
    frmMain.txtTitle.Text = GetVar(FileName, "CONFIG", "PageTitle")
    frmMain.txtFont.Text = GetVar(FileName, "CONFIG", "Font")
    frmMain.txtSize.Text = GetVar(FileName, "CONFIG", "FontSize")
    frmMain.txtColor.Text = GetVar(FileName, "CONFIG", "FontColor")
    frmMain.txtBGColor.Text = GetVar(FileName, "CONFIG", "Background")
    frmMain.txtMBC.Text = GetVar(FileName, "CONFIG", "TableMBColor")
    frmMain.txtDBC.Text = GetVar(FileName, "CONFIG", "TableDBColor")
    frmMain.txtBC.Text = GetVar(FileName, "CONFIG", "TableBorderColor")
    frmMain.txtWidth.Text = GetVar(FileName, "CONFIG", "TableWidth")
    
    SetStatus "Loading NPCs..."
    LoadNpcs
    SetStatus "Loaded NPCs!"
    
    SetStatus "Loading Items..."
    LoadItems
    SetStatus "Loaded Items!"
    
    SetStatus "Loading Classes..."
    LoadClasses
    SetStatus "Loaded Classes!"
    
    SetStatus "Loading Shops..."
    LoadShops
    SetStatus "Loaded Shops!"
    
    SetStatus "Loading Maps..."
    LoadMaps
    SetStatus "Loaded Maps!"
    
    SetStatus "Program Loaded!"
    
    frmMain.Enabled = True
End Sub

Function GetVar(File As String, Header As String, Var As String) As String
Dim sSpaces As String   ' Max string length
Dim szReturn As String  ' Return default value if not found
  
    szReturn = ""
  
    sSpaces = Space(5000)
  
    Call GetPrivateProfileString(Header, Var, szReturn, sSpaces, Len(sSpaces), File)
  
    GetVar = RTrim(sSpaces)
    GetVar = Left(GetVar, Len(GetVar) - 1)
End Function

Sub PutVar(File As String, Header As String, Var As String, Value As String)
    Call WritePrivateProfileString(Header, Var, Value, File)
End Sub

Function FileExist(ByVal FileName As String) As Boolean
    If Dir(FileName) = "" Then
        FileExist = False
    Else
        FileExist = True
    End If
End Function

Sub LoadMaps()
Dim FileName As String
Dim i As Long
Dim f As Long
    
    For i = 1 To MAX_MAPS
        Call SetStatus("Loading Maps... " & i & "/" & MAX_MAPS)
        FileName = App.Path & "\maps\map" & i & ".dat"
        
        If FileExist(FileName) = True Then
            f = FreeFile
            Open FileName For Binary As #f
                Get #f, , Map(i)
            Close #f
        End If
    
        DoEvents
    Next i
End Sub

Sub LoadShops()
Dim FileName As String
Dim i As Long, f As Long
    
    For i = 1 To MAX_SHOPS
        Call SetStatus("Loading Shops... " & i & "/" & MAX_SHOPS)
        FileName = App.Path & "\shops\shop" & i & ".dat"
        If FileExist(FileName) = True Then
            f = FreeFile
            Open FileName For Binary As #f
                Get #f, , Shop(i)
            Close #f
        End If
        DoEvents
    Next i
End Sub

Sub LoadClasses()
Dim FileName As String
Dim i As Long

    FileName = App.Path & "\classes.ini"
    
    If FileExist(FileName) = True Then
        Max_Classes = Val(GetVar(FileName, "INIT", "MaxClasses"))
        
        ReDim Class(0 To Max_Classes) As ClassRec
                
        For i = 0 To Max_Classes
            Call SetStatus("Loading Classes... " & i & "/" & Max_Classes)
            Class(i).Name = GetVar(FileName, "CLASS" & i, "Name")
            DoEvents
        Next i
    End If
End Sub

Sub LoadNpcs()
Dim FileName As String
Dim i As Long
Dim z As Long
Dim f As Long
        
    For i = 1 To MAX_NPCS
        SetStatus "Loading NPCs... " & i & "/" & MAX_NPCS
        FileName = App.Path & "\npcs\npc" & i & ".dat"
        If FileExist(FileName) = True Then
            f = FreeFile
            Open FileName For Binary As #f
                Get #f, , Npc(i)
            Close #f
            
            DoEvents
        End If
    Next i
End Sub

Sub LoadItems()
Dim FileName As String
Dim i As Long
Dim f As Long
    
    For i = 1 To MAX_ITEMS
        Call SetStatus("Loading Items... " & i & "/" & MAX_ITEMS)
        FileName = App.Path & "\Items\Item" & i & ".dat"
        If FileExist(FileName) = True Then
            f = FreeFile
            Open FileName For Binary As #f
                Get #f, , Item(i)
            Close #f
            
            DoEvents
        End If
    Next i
End Sub

Sub SetStatus(ByVal Msg As String)
    frmMain.lblStatus.Caption = Trim(Msg)
End Sub

Public Sub TextAdd(Msg As String, NewLine As Boolean, index As Long)

    If NewLine Then
        frmMain.txtHTML2(index).Text = frmMain.txtHTML2(index).Text & vbCrLf & Msg
    Else
        frmMain.txtHTML2(index).Text = frmMain.txtHTML2(index).Text & Msg
    End If
End Sub

Sub SaveFile(ByVal FileName As String, index As Long)
Dim f As Long
    FileName = App.Path & "\HTML Docs\" & FileName
    f = FreeFile
    Open FileName For Append As #f
        Print #f, frmMain.txtHTML2(index).Text
    Close #f
End Sub

Sub CreateNPCDatabase()
Dim i As Long, d As Long, MapNum As Long, c As Long, donen() As Boolean
ReDim donen(1 To MAX_NPCS) As Boolean
Dim PicX As Long, PicY As Long

    PicX = 3
    
    If frmMain.chkNPCPicture.Value = Checked Then
        frmMain.picSprites.Picture = LoadPicture(App.Path & "\sprites.bmp")
        frmMain.picBigSprites.Picture = LoadPicture(App.Path & "\bigsprites.bmp")
    End If

    SetStatus "Making Code..."
    frmMain.Enabled = False
    frmMain.txtHTML2(0).Text = ""
    TextAdd "<html>", False, 0
    TextAdd "<head><title>" & Trim(frmMain.txtTitle.Text) & "</title><STYLE>", True, 0
    TextAdd "    body, td {", True, 0
    TextAdd "    font-family: " & Trim(frmMain.txtFont.Text) & ";", True, 0
    TextAdd "    font-size: " & Trim(frmMain.txtSize.Text) & "px;", True, 0
    TextAdd "    color: " & Trim(frmMain.txtColor.Text) & ";", True, 0
    TextAdd "}", True, 0
    TextAdd "</STYLE></head>", True, 0
    TextAdd "<body bgcolor=""" & Trim(frmMain.txtBGColor) & """leftmargin=""0"" topmargin=""10"" marginwidth=""0"" marginheight=""0""><div align=""center"">", True, 0
    TextAdd "<table width=""" & Trim(frmMain.txtWidth.Text) & """ border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" bordercolor=""" & Trim(frmMain.txtBC.Text) & """>", True, 0
    TextAdd "  <td align=""center""  bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>NPC</td>", True, 0
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>HP</td>", True, 0
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>STR</td>", True, 0
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>DEF</td>", True, 0
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>EXP</td>", True, 0
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Item Drops</td>", True, 0
    If frmMain.chkNpcLocation.Value = Checked Then TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Location</td>", True, 0
    
    TextAdd "", True, 0
    For i = 1 To MAX_NPCS
        SetStatus "Making Code... (" & i & "/" & MAX_NPCS & ")"
        If Trim(Npc(i).Name) <> "" Then
            If frmMain.chkNPCPicture.Value = Checked Then
                If LCase(Dir(App.Path & "\html docs\npc pics", vbDirectory)) <> "npc pics" Then Call MkDir(App.Path & "\html docs\NPC Pics")
                PicY = Npc(i).Sprite
                TextAdd "<tr><td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>" & Trim(Npc(i).Name) & "<br>", True, 0
                TextAdd "<img src=""NPC Pics/NPC" & i & ".bmp""></td>", False, 0
                
                If Npc(i).Big = 0 Then
                    frmMain.picPic.Width = 32
                    frmMain.picPic.Height = 32
                    RetVal = BitBlt(frmMain.picPic.hDC, 0, 0, 32, 32, frmMain.picSprites.hDC, PicX * 32, PicY * 32, SRCCOPY)
                Else
                    frmMain.picPic.Width = 64
                    frmMain.picPic.Height = 64
                    RetVal = BitBlt(frmMain.picPic.hDC, 0, 0, 64, 64, frmMain.picBigSprites.hDC, PicX * 64, PicY * 64, SRCCOPY)
                End If
                frmMain.picPic2.Picture = CaptureArea(frmMain, frmMain.picPic.Left, frmMain.picPic.Top, frmMain.picPic.Width, frmMain.picPic.Height)
                SavePicture frmMain.picPic2.Picture, App.Path & "\HTML Docs\NPC Pics\NPC" & i & ".bmp"
            Else
                TextAdd "<tr><td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>" & Trim(Npc(i).Name) & "</td>", True, 0
            End If
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Npc(i).MaxHp & "</td>", False, 0
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Npc(i).STR & "</td>", False, 0
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Npc(i).DEF & "</td>", False, 0
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Npc(i).EXP & "</td>", False, 0

            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>", False, 0
            For d = 1 To MAX_NPC_DROPS
                If Npc(i).ItemNPC(d).ItemNum > 0 Then
                    If Item(Npc(i).ItemNPC(d).ItemNum).Type = ITEM_TYPE_CURRENCY Then
                        TextAdd Npc(i).ItemNPC(d).ItemValue & " " & Trim(Item(Npc(i).ItemNPC(d).ItemNum).Name) & "<br>", False, 0
                    Else
                        TextAdd Trim(Item(Npc(i).ItemNPC(d).ItemNum).Name) & "<br>", False, 0
                    End If
                End If
    
            Next d
            TextAdd "</td>", False, 0
            
            If frmMain.chkNpcLocation.Value = Checked Then
                TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>", False, 0
                
                For MapNum = 1 To MAX_MAPS
                    For c = 1 To MAX_MAP_NPCS
                        If Map(MapNum).Npc(c) > 0 Then
                            If Map(MapNum).Npc(c) = i Then
                                MapNPCs(i) = MapNPCs(i) + 1
                            End If
                        End If
                    Next c
                    
                    For c = 1 To MAX_MAP_NPCS
                        If Map(MapNum).Npc(c) > 0 Then
                            If Map(MapNum).Npc(c) = i Then
                                If donen(i) = False Then
                                    TextAdd Trim(Map(MapNum).Name) & "(" & MapNPCs(i) & ")<br>", False, 0
                                    donen(i) = True
                                End If
                            End If
                        End If
                    Next c
                    donen(i) = False
                    MapNPCs(i) = 0
                Next MapNum
            End If
            
            TextAdd "</tr>", False, 0
        End If
        
        DoEvents
    Next i
    
    TextAdd "</table>", True, 0
    TextAdd "</div></body>", True, 0
    TextAdd "</html>", True, 0
        
    frmMain.Enabled = True
    SetStatus "Code Complete!"
End Sub

Sub CreateItemDatabase()
Dim i As Long, s As String, c As Long, d As Long
Dim a1 As String, a2 As String, a3 As String
Dim reqStr As String, reqDef As String, reqSpeed As String, reqAccess As String, reqClass As String
Dim bStr As String, bDef As String, bSpeed As String, bVit As String, bMagi As String, bExp As String
Dim bHp As String, bMp As String, bSp As String
Dim Done() As Boolean, donen() As Boolean
Dim PicX As Long, PicY As Long

ReDim Done(1 To MAX_NPCS) As Boolean
ReDim donen(1 To MAX_SHOPS) As Boolean
    
    If frmMain.chkItemPicture.Value = Checked Then frmMain.picItems.Picture = LoadPicture(App.Path & "\items.bmp")

    SetStatus "Making Code..."
    frmMain.Enabled = False
    frmMain.txtHTML2(1).Text = ""
    
    TextAdd "<html>", False, 1
    TextAdd "<head><title>" & Trim(frmMain.txtTitle.Text) & "</title><STYLE>", True, 1
    TextAdd "    body, td {", True, 1
    TextAdd "    font-family: " & Trim(frmMain.txtFont.Text) & ";", True, 1
    TextAdd "    font-size: " & Trim(frmMain.txtSize.Text) & "px;", True, 1
    TextAdd "    color: " & Trim(frmMain.txtColor.Text) & ";", True, 1
    TextAdd "}", True, 1
    TextAdd "</STYLE></head>", True, 1
    TextAdd "<body bgcolor=""" & Trim(frmMain.txtBGColor) & """leftmargin=""0"" topmargin=""10"" marginwidth=""0"" marginheight=""0""><div align=""center"">", True, 1
    TextAdd "<table width=""" & Trim(frmMain.txtWidth.Text) & """ border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" bordercolor=""" & Trim(frmMain.txtBC.Text) & """>", True, 1
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Item</td>", True, 1
    TextAdd "  <td align=""center""bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Description</td>", True, 1
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Type</td>", True, 1
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Attribute</td>", True, 1
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Requirements</td>", True, 1
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Bonuses</td>", True, 1
    If frmMain.chkINPCLocation.Value = Checked Then TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>NPC Location</td>", True, 1
    If frmMain.chkIShopLocation.Value = Checked Then TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Shop Location</td>", True, 1
    TextAdd "", True, 1
    For i = 1 To MAX_ITEMS
        SetStatus "Making Code... (" & i & "/" & MAX_ITEMS & ")"
        If Trim(Item(i).Name) <> "" Then
        
            For c = 1 To MAX_NPCS
                Done(c) = False
            Next c
            
            For d = 1 To MAX_SHOPS
                donen(d) = False
            Next d

            If frmMain.chkItemPicture.Value = Checked Then
                If LCase(Dir(App.Path & "\html docs\item pics", vbDirectory)) <> "item pics" Then Call MkDir(App.Path & "\html docs\Item Pics")
                PicY = Int(Item(i).Pic / 6)
                PicX = (Item(i).Pic - Int(Item(i).Pic / 6) * 6)
                TextAdd "<tr><td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>" & Trim(Item(i).Name) & "<br>", True, 1
                TextAdd "<img src=""Item Pics/Item" & i & ".bmp""></td>", False, 1
                RetVal = BitBlt(frmMain.picPic.hDC, 0, 0, 32, 32, frmMain.picItems.hDC, PicX * 32, PicY * 32, SRCCOPY)
                frmMain.picPic2.Picture = CaptureArea(frmMain, frmMain.picPic.Left, frmMain.picPic.Top, frmMain.picPic.Width, frmMain.picPic.Height)
                SavePicture frmMain.picPic2.Picture, App.Path & "\HTML Docs\Item Pics\Item" & i & ".bmp"
            Else
                TextAdd "<tr><td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>" & Trim(Item(i).Name) & "</td>", True, 1
            End If
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Trim(Item(i).desc) & "</td>", False, 1
            
            a1 = ""
            a2 = ""
            a3 = ""
            reqStr = ""
            reqDef = ""
            reqSpeed = ""
            reqAccess = ""
            reqClass = ""
            
            bStr = ""
            bDef = ""
            bVit = ""
            bSpeed = ""
            bMagi = ""
            bExp = ""
            bHp = ""
            bMp = ""
            bSp = ""
            
            If Item(i).Type >= 1 And Item(i).Type <= 4 Then
                If Item(i).Data1 >= 0 Then
                    a1 = Item(i).Data1 & " Dur<br>"
                Else
                    a1 = "Indestructible<br>"
                End If

                If Item(i).StrReq > 0 Then reqStr = Item(i).StrReq & " Str<br>"
                If Item(i).DefReq > 0 Then reqDef = Item(i).DefReq & " Def<br>"
                If Item(i).SpeedReq > 0 Then reqSpeed = Item(i).SpeedReq & " Speed<br>"
                If Item(i).AccessReq > 0 Then reqAccess = Item(i).AccessReq & " Access<br>"
                If Item(i).ClassReq > 0 Then reqClass = "Class: " & Trim(Class(Item(i).ClassReq).Name) & "<br>"

                If Item(i).AddStr > 0 Then bStr = "Str Added: " & Item(i).AddStr & "<br>"
                If Item(i).AddDef > 0 Then bDef = "Def Added: " & Item(i).AddDef & "<br>"
                If Item(i).Data3 > 0 Then bVit = "Vit Added: " & Item(i).Data3 & "<br>"
                If Item(i).AddSpeed > 0 Then bSpeed = "Speed Added: " & Item(i).AddSpeed & "<br>"
                If Item(i).AddMagi > 0 Then bMagi = "Magi Added: " & Item(i).AddMagi & "<br>"
                If Item(i).AddEXP > 0 Then bExp = "Exp Added: " & Item(i).AddEXP & "%<br>"
                If Item(i).AddHP > 0 Then bHp = "Hp Added: " & Item(i).AddHP & "<br>"
                If Item(i).AddMP > 0 Then bMp = "Mp Added: " & Item(i).AddMP & "<br>"
                If Item(i).AddSP > 0 Then bSp = "Sp Added: " & Item(i).AddSP & "<br>"
            End If
            
            If Item(i).Type = 0 Then
                s = "None"
            ElseIf Item(i).Type = 1 Then
                s = "Weapon"
                If Item(i).Data2 > 0 Then a2 = Item(i).Data2 & " Damage"
            ElseIf Item(i).Type = 2 Then
                s = "Armor"
                If Item(i).Data2 > 0 Then a2 = Item(i).Data2 & " Defence"
            ElseIf Item(i).Type = 3 Then
                s = "Helmet"
                If Item(i).Data2 > 0 Then a2 = Item(i).Data2 & " Defence"
            ElseIf Item(i).Type = 4 Then
                s = "Shield"
                If Item(i).Data2 > 0 Then a2 = Item(i).Data2 & " Defence"
            ElseIf Item(i).Type >= 5 And Item(i).Type < 11 Then
                s = "Potion"
                a1 = "Heal " & Item(i).Data1
            ElseIf Item(i).Type = 11 Then
                s = "Key"
            ElseIf Item(i).Type = 12 Then
                s = "Currency"
            ElseIf Item(i).Type = 13 Then
                s = "Spell"
                If Item(i).Data1 > 0 Then
                    a1 = "Spell " & Item(i).Data1
                Else
                    a1 = "Spell: None"
                End If
            ElseIf Item(i).Type = 14 Then
                s = "Scroll"
                If Item(i).Data1 > 0 Then
                    a1 = "Map " & Item(i).Data1 & "<br>"
                Else
                    a1 = "Map: None<br>"
                End If
                If Item(i).Data2 > 0 Then
                    a2 = "X " & Item(i).Data2 & "<br>"
                Else
                    a2 = "X: None<br>"
                End If
                If Item(i).Data2 > 0 Then
                    a3 = "Y " & Item(i).Data2
                Else
                    a3 = "Y: None"
                End If
            ElseIf Item(i).Type = 15 Then
                s = "Orb"
                If Item(i).Data1 > 0 Then
                    a1 = "Map " & Item(i).Data1 & "<br>"
                Else
                    a1 = "Map: None<br>"
                End If
                If Item(i).Data2 > 0 Then
                    a2 = "X " & Item(i).Data2 & "<br>"
                Else
                    a2 = "X: None<br>"
                End If
                If Item(i).Data2 > 0 Then
                    a3 = "Y " & Item(i).Data2
                Else
                    a3 = "Y: None"
                End If
            End If
            
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Trim(s) & "</td>", False, 1
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Trim(a1) & Trim(a2) & Trim(a3) & "</td>", False, 1
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & reqStr & reqDef & reqSpeed & reqClass & reqAccess & "</td>", False, 1
            TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & bStr & bDef & bVit & bSpeed & bMagi & bExp & bHp & bMp & bSp & "</td>", False, 1
        
            If frmMain.chkINPCLocation.Value = Checked Then
                TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>", False, 1
                For c = 1 To MAX_NPCS
                    For d = 1 To MAX_NPC_DROPS
                        If Npc(c).ItemNPC(d).ItemNum = i Then
                            If Done(c) = False Then
                                TextAdd Trim(Npc(c).Name) & "<br>", False, 1
                                Done(c) = True
                            End If
                        End If
                    Next d
                Next c
                TextAdd "</td>", False, 1
            End If
            
            If frmMain.chkIShopLocation.Value = Checked Then
                TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>", False, 1
                For c = 1 To MAX_SHOPS
                    For d = 1 To MAX_TRADES
                        If Shop(c).TradeItem(d).Value(d).GetItem = i Then
                            If donen(c) = False Then
                                TextAdd Trim(Shop(c).Name) & "<br>", False, 1
                                donen(c) = True
                            End If
                        End If
                    Next d
                Next c
                TextAdd "</td>", False, 1
            End If
            
            TextAdd "</tr>", False, 1
        End If
        
        DoEvents
    Next i
    
    TextAdd "</table>", True, 1
    TextAdd "</div></body>", True, 1
    TextAdd "</html>", True, 1
        
    frmMain.Enabled = True
    SetStatus "Code Complete!"
End Sub

Sub CreateShopDatabase()
Dim i As Long, d As Long, x As Long, y As Long, MapNum As Long

    SetStatus "Making Code..."
    frmMain.Enabled = False
    frmMain.txtHTML2(2).Text = ""
    
    TextAdd "<html>", False, 2
    TextAdd "<head><title>" & Trim(frmMain.txtTitle.Text) & "</title><STYLE>", True, 2
    TextAdd "    body, td {", True, 2
    TextAdd "    font-family: " & Trim(frmMain.txtFont.Text) & ";", True, 2
    TextAdd "    font-size: " & Trim(frmMain.txtSize.Text) & "px;", True, 2
    TextAdd "    color: " & Trim(frmMain.txtColor.Text) & ";", True, 2
    TextAdd "}", True, 2
    TextAdd "</STYLE></head>", True, 2
    TextAdd "<body bgcolor=""" & Trim(frmMain.txtBGColor) & """leftmargin=""0"" topmargin=""10"" marginwidth=""0"" marginheight=""0""><div align=""center"">", True, 2
    TextAdd "<table width=""" & Trim(frmMain.txtWidth.Text) & """ border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" bordercolor=""" & Trim(frmMain.txtBC.Text) & """>", True, 2
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Shop</td>", True, 2
    For i = 1 To MAX_TRADES
        TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Slot" & i & "</td>", True, 2
    Next i
    TextAdd "  <td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>Location</td>", True, 2
    TextAdd "", True, 2
    For i = 1 To MAX_SHOPS
        SetStatus "Making Code... (" & i & "/" & MAX_SHOPS & ")"
        If Trim(Shop(i).Name) <> "" Then
            TextAdd "<tr><td align=""center"" bgcolor=""" & Trim(frmMain.txtMBC.Text) & """>" & Trim(Shop(i).Name) & "</td>", True, 2
            For d = 1 To MAX_TRADES
                If Shop(i).TradeItem(d).Value(d).GiveItem > 0 Then
                    TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>" & Shop(i).TradeItem(d).Value(d).GiveValue & " " & Trim(Item(Shop(i).TradeItem(d).Value(d).GiveItem).Name) & "<br><b> Trade For </b><br>" & Shop(i).TradeItem(d).Value(d).GetValue & " " & Trim(Item(Shop(i).TradeItem(d).Value(d).GetItem).Name) & "</td>", False, 2
                Else
                    TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """></td>", False, 2
                End If
            Next d
            
            If frmMain.chkLocation.Value = Checked Then
                TextAdd "    <td align=""center"" bgcolor=""" & Trim(frmMain.txtDBC.Text) & """>", False, 2
                For MapNum = 1 To MAX_MAPS
                    For x = 0 To MAX_MAPX
                        For y = 0 To MAX_MAPY
                            If Map(MapNum).Tile(x, y).Type = TILE_TYPE_SHOP Then
                                If Map(MapNum).Tile(x, y).Data1 = i Then
                                    If ShopMap(MapNum) = False Then
                                        ShopMap(MapNum) = True
                                        If frmMain.chkMapNum.Value = Checked Then
                                            TextAdd Trim(Map(MapNum).Name) & " (Map " & MapNum & ")<br><br>", False, 2
                                        Else
                                            TextAdd Trim(Map(MapNum).Name) & "<br><br>", False, 2
                                        End If
                                    End If
                                End If
                            End If
                            DoEvents
                        Next y
                    Next x
                Next MapNum
                TextAdd "</td>", False, 2
            End If
            
            TextAdd "</tr>", False, 2
            
            For MapNum = 1 To MAX_MAPS
                ShopMap(MapNum) = False
            Next MapNum
        End If
        DoEvents
    Next i
    
    TextAdd "</table>", True, 2
    TextAdd "</div></body>", True, 2
    TextAdd "</html>", True, 2
        
    frmMain.Enabled = True
    SetStatus "Code Complete!"
End Sub
